home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / risc_src.lha / risc_sources / sys / sparckernel.t < prev    next >
Text File  |  1990-04-12  |  12KB  |  339 lines
  1. (herald sparckernel (env tsys))
  2.  
  3. ;;; Copyright (c) 1985 Yale University
  4. ;;;     Authors: N Adams, R Kelsey, D Kranz, J Philbin, J Rees.
  5. ;;; This material was developed by the T Project at the Yale University Computer 
  6. ;;; Science Department.  Permission to copy this software, to redistribute it, 
  7. ;;; and to use it for any purpose is granted, subject to the following restric-
  8. ;;; tions and understandings.
  9. ;;; 1. Any copy made of this software must include this copyright notice in full.
  10. ;;; 2. Users of this software agree to make their best efforts (a) to return
  11. ;;;    to the T Project at Yale any improvements or extensions that they make,
  12. ;;;    so that these may be included in future releases; and (b) to inform
  13. ;;;    the T Project of noteworthy uses of this software.
  14. ;;; 3. All materials developed as a consequence of the use of this software
  15. ;;;    shall duly acknowledge such use, in accordance with the usual standards
  16. ;;;    of acknowledging credit in academic research.
  17. ;;; 4. Yale has made no warrantee or representation that the operation of
  18. ;;;    this software will be error-free, and Yale is under no obligation to
  19. ;;;    provide any services, by way of maintenance, update, or otherwise.
  20. ;;; 5. In conjunction with products arising from the use of this material,
  21. ;;;    there shall be no use of the name of the Yale University nor of any
  22. ;;;    adaptation thereof in any advertising, promotional, or sales literature
  23. ;;;    without prior written consent from Yale in each case.
  24. ;;;
  25.  
  26. ;;; The procedure big_bang MUST come first in this file.
  27. ;;; BIG_BANG is called to instantiate the root process of an external
  28. ;;; T image. It is called by a foreign stub program with arguments
  29. ;;; as follows:
  30. ;;;
  31. ;;;  (BIG_BANG memory mem-size argc argv bsd4.2?).
  32. ;;;
  33. ;;; The argument vector is saved as a T vector in *BOOT-ARGS*.  The
  34. ;;; Xenoids are created for STDIN and STDOUT and placed in the 2nd
  35. ;;; and 3rd argument registers.  The global-constant register (NIL)
  36. ;;; and the task register are initialized, and the root process
  37. ;;; block is created and initialized.  The stack is initialized.
  38. ;;; The heap-pointer and heap-limit of the root process are
  39. ;;; initialized.  Finally the address of the T procedure BOOT is
  40. ;;; placed in them P (procedure) register, and we jump through the
  41. ;;; root process block to ICALL.  Boot is called as follows:
  42. ;;;
  43. ;;;     (BOOT root-task boot-args),
  44.  
  45. ;;; Unresolved issues:
  46. ;;; - Is the arg vector the right size and is the descriptor correct?
  47. ;;; - What should the initial stack size be and how can you tell?
  48. ;;; - The stack and areas should have guards - later I  guess
  49. ;;; - how to boot other systems
  50. ;;; - stdio shit?
  51. ;;; - PID as Fixnum?
  52. ;;; - *the-slink*
  53. ;;; - test stack-overflow in icall?
  54. ;;; - heap overflow code
  55. ;;; - exception code
  56. ;;; - interrupt code
  57.  
  58.  
  59. ;;;  When we enter Big_bang the stack looks as follows:
  60. ;;;
  61. ;;;              |      debug?   |
  62. ;;;              |_______________|
  63. ;;;              |      argv     |    Command line argv
  64. ;;;              |_______________|
  65. ;;;              |      argc     |    Command line argc
  66. ;;;              |_______________|
  67. ;;;              |  heap-size    |  
  68. ;;;              |_______________|
  69. ;;;              |     heap2     | 
  70. ;;;              |_______________|  
  71. ;;;              |     heap1     |
  72. ;;;              |_______________|
  73. ;;;       SP =>  |     dummy     |
  74. ;;;              |_______________|
  75. ;;;              |    header     |  <= *boot-args*
  76. ;;;              |_______________|
  77.  
  78. (define (big_bang)
  79.   (lap (*boot* *the-slink* risc-big-bang)
  80.                     ;big_bang is in SP
  81.                     ;interrupt handler in link
  82.     ;; set up global-constants
  83. ;    (save ($ (- (* 4 (+ 16 6 1 8 1)))) ssp ssp)
  84.  ; min size + boot args + 2  dummy + double word alignment
  85.     (move SP P)                ;big_bang
  86.     (load l (d@r P (static *the-slink*)) nil-reg)
  87.     (load l (d@r nil-reg 2) nil-reg)
  88.     (sub ($ 3) nil-reg sp)        ;grows down to data bottom 512K
  89.     (sll ($ 2) link-reg)
  90.     (store l link-reg (d@nil slink/interrupt-handler))    ; interrupt_xenoid
  91.     (move ($ header/true) t-reg)
  92.     (move zero crit-reg)
  93.     (sub ($ (* 8 4)) sp)
  94.     (store l ass-reg (d@r sp (+ 8 0)))        ;heap1  a8 = %o0
  95.     (store l extra-args (d@r sp (+ 8 4)))        ;heap2
  96.     (store l extra (d@r sp (+ 8 8)))        ;heap-size
  97.     (store l parassign-extra (d@r sp (+ 8 12)))        ;argc
  98.     (store l vector (d@r sp (+ 8 16)))        ;argc
  99.     (store l scratch (d@r sp (+ 8 20)))        ;argc
  100.     (add ($ 8) sp A1)  ; save argument pointer        
  101.     (movec (fx+ (fixnum-ashl 6 8) header/general-vector) extra)
  102.     (store l extra (d@r sp 0))
  103.     (add ($ 2) sp a2)
  104.     (store l A2 (d@nil slink/boot-args))    ; we have 6 boot-args
  105.  
  106.     (load l (d@r P (static risc-big-bang)) P)
  107.     (load l (d@r p 2) p)
  108.     (load l (d@r P -2) extra)
  109.     (add ($ 2) extra)
  110.     (jalr extra)
  111.     (add ($ 8) link-reg)
  112.     ;; initialize area, area-frontier, and area-limit
  113.     (load l  (d@r A1 0) scratch)                       ; move addr heap
  114.     (store l scratch (d@nil slink/area-begin))      
  115.     (store l scratch (d@nil slink/area-frontier))         
  116.     (load l (d@r A1 8) vector)
  117.     (add vector scratch)
  118.     (store l scratch (d@nil slink/area-limit))
  119.  
  120.     ;; Set up the procedure register P and call boot,
  121.     ;; never to return. (note: args 2 was setup above)
  122.     (move nil-reg A3)
  123.     (load l (d@r a1 20) extra)
  124.     (j= extra zero %debug)
  125.     (move t-reg A3)
  126. %debug
  127.     (store l zero (d@nil slink/saved-ssp))
  128.     (load l (d@r P (static *boot*)) P)
  129.     (load l (d@r p 2) p)
  130.     (load l (d@r P -2) extra)
  131.     (add ($ 2) extra)
  132.     (jr extra)
  133.     (move  ($ 4) NARGS)))                            
  134.  
  135.  
  136. ;;;; Low-level exception handling
  137.  
  138. ;;; Interrupts can be deferred.   
  139. ;;; the task/critical count byte has
  140. ;;; bit 7 -- interrupts deferred
  141. ;;; bit 0 -- quit pending
  142.  
  143. (define (interrupt_dispatcher)       ; signal=%o0,code=%o1,context=%o2
  144.   (lap (signal-handler enable-signals gc-interrupt)
  145.     (load l (d@r %o3 (static *the-slink*)) %o4) ;unit is in a11(i3)
  146.     (load l (d@r %o4 2) %o4)
  147.     (load l (d@r %o4 slink/doing-gc?) %o5)
  148.     (jn= %o5 %o4 %doing-gc)    ; are we doing gc?
  149.     (load l (d@r %o4 slink/saved-sp) %o5)
  150.     (jn= %o5 zero %foreign)
  151.     (load l (d@r %o2 24) sp)        ;sc_g1 = sp
  152.     (jn= %o0 ($ 2) %fault)                   ; is this a ^c?
  153.     (load l (d@r %o2 8) %o1)        ;fault ssp
  154.     (load l (d@r %o1 (* 4 15)) %o2)    ;saved crit-reg (i7)
  155.     (mask ($ 1) %o2 %o5)    ; is this the second one?                
  156.     (j= %o5 zero %set-interrupt-flag) ; if not, defer interrupt
  157.     (mask ($ #xfe) %o2)        ;turn off bit 0
  158.     (store l %o2 (d@r %o1 (* 4 15))) 
  159.     (j= %o2 zero %fault)        ; are interrupts deferred?
  160. %set-interrupt-flag    
  161.     (or ($ 1) %o2)            ; set quit bit
  162.     (store l %o2 (d@r %o1 (* 4 15))) 
  163. %ignore-interrupt 
  164.     (jmpl (d@r link-reg 8) zero)
  165.     (noop)
  166. %doing-gc
  167.     (jmpl (d@r link-reg 8) zero)
  168.     (noop)
  169.  
  170. ;;; Interrupts should be disabled here.
  171. %foreign
  172.     (move %o5 sp)            ;saved sp
  173.     (store l zero (d@r %o4 slink/saved-sp))
  174.     (restore zero zero zero)        ;link reg at time of foreign
  175.     (save a5 zero %o1)            ;call is in A5=%l5
  176.     (jbr %shared-fault)
  177. %fault
  178.     (move crit-reg %o1)            ;crit-reg = %i7 = return address (link)
  179.     (move zero %o5)
  180. %shared-fault
  181.     (sub ($ 12) sp)            ;retore if we throw out
  182.     (store l %o1 (d@r sp 8))        ;describe top of stack, old link-reg
  183.     (store l %o5 (d@r sp 4))        ;saved sp
  184.     (store l link-reg (d@r sp 0))    ;save handler ra
  185.     (save ($ -64) ssp ssp)
  186.     (move %i4 nil-reg)            ;%o4->%i4 from save 
  187.     (move ($ header/true) t-reg)
  188.     (load l  (d@r %i3 (static signal-handler)) p)
  189.     (load l (d@r p 2) p)
  190.     (move zero a1)            ;dummy ssp
  191.     (sll ($ 2) %i0 a2)            ;signal number
  192.     (move zero a3)
  193.     (move zero a4)
  194.     (move zero a5)
  195.     (move zero a6)
  196.     (move zero a7)
  197.     (move zero a8)
  198.     (move zero a9)
  199.     (move zero a10)
  200.     (move zero a11)
  201.     (move zero an)
  202.     (move zero an+1)
  203.     (move zero extra-args)
  204.     (move zero parassign-extra)
  205.     (move zero ass-reg)
  206.     (move zero crit-reg)
  207.     (load l (d@r p -2) extra)
  208.     (add ($ 2) extra)
  209.     (move ($ 3) nargs)
  210.     (jalr extra)
  211.     (add ($ template-return-offset) link-reg)
  212.     (template 2 -1 t)
  213.     (load l (d@r sp 4) %o1)
  214.     (store l %o1 (d@nil slink/saved-sp))
  215.     (restore zero zero zero)
  216.     (load l (d@r sp 0) link-reg)    ;restore handler ra
  217.     (jmpl (d@r link-reg 8) zero)    ;return to fault
  218.     (add ($ 12) sp)))
  219.  
  220.  
  221. (define (reset-ssp ssp)
  222.   (lap ()
  223.     (move nil-reg t-reg)        ;t-reg is only global we can use
  224.     (restore zero link-reg link-reg)    ;restore our save
  225.     (restore zero link-reg link-reg)    ;restore fault handler's save
  226.     (move t-reg nil-reg)        ;restore nil
  227.     (move ($ header/true) t-reg)    ;restore t
  228.     (move zero p)
  229.     (move zero a1)
  230.     (move zero a2)
  231.     (move zero a3)
  232.     (move zero a4)
  233.     (move zero a5)
  234.     (move zero a6)
  235.     (move zero a7)
  236.     (move zero a8)
  237.     (move zero a9)
  238.     (move zero a10)
  239.     (move zero a11)
  240.     (move zero an)
  241.     (move zero an+1)
  242.     (move zero extra)
  243.     (move zero extra-args)
  244.     (move zero parassign-extra)
  245.     (move zero ass-reg)
  246.     (move zero crit-reg)
  247.     (jr link-reg)
  248.     (move ($ -1) nargs)))
  249.  
  250. (define (flush-code-from-icache bytev)
  251.   (lap ()
  252.     (load l (d@r a1 -2) scratch)
  253.     (sra ($ 8) scratch)            ;length in bytes
  254.     (add a1 scratch)            ;past end
  255.     (jbr flush-test)
  256. flush-loop
  257.     (iflush ($ 2) a1 zero)
  258.     (add ($ 4) a1)
  259. flush-test
  260.     (j< a1 scratch flush-loop)
  261.     (move zero a1)
  262.     (jr link-reg)
  263.     (move ($ -2) nargs)))
  264.     
  265.  
  266. (define local-processor
  267.   (lambda ()
  268.     (object nil
  269.       ((processor-type self)     'sparc)
  270.       ((print-type-string self)  "Processor"))))
  271.  
  272. (define (local-machine)
  273.   (object nil                               
  274.       ((machine-type self)          'sparc)
  275.       ((machine-suspend-file self) '(link sparcsuspend))
  276.       ((object-file-type self)      'so)
  277.       ((information-file-type self) 'si)
  278.       ((noise-file-type self)       'sn)
  279.       ((debug-file-type self)       'sd)
  280.       ((print-type-string self)     "Machine")))
  281.  
  282. (define (nan? x)
  283.   (or (fx= (isnan x) 1)
  284.       (fx= (isinf x) 1)))
  285.  
  286. (define-foreign isnan ("isnan" (in rep/double)) rep/integer)
  287. (define-foreign isinf ("isinf" (in rep/double)) rep/integer)
  288.  
  289. (define (st_mtime stat-block)
  290.   (+ (ash (mref-16-u stat-block 32) 16) 
  291.      (mref-16-u stat-block 34)))
  292.  
  293. (define-integrable (st_size stat-block)
  294.   (mref-integer stat-block 20))
  295.  
  296.  
  297. (define-integrable (st_mode stat-block)
  298.   (mref-16-u stat-block 8))
  299.  
  300. (define-constant %%apollo-d-ieee-size 53)
  301. (define-constant %%apollo-d-ieee-excess 1023)
  302.  
  303. ;;; <n,s> means bit field of length s beginning at bit n of the first
  304. ;;; WORD (not longword)
  305. ;;;                    sign      exponent   MSB       fraction
  306. ;;; IEEE flonum        <15,1>    <4,11>     hidden    <0,4>+next 3 words
  307. ;;; VAX11 flonum (D)   <15,1>    <7,8>      hidden    <0,7>+next 3 words
  308.  
  309. (define (integer-decode-float x)     ; IEEE version
  310.   (let ((a (mref-16-u x 0)))
  311.     (return (if (fl<= 0.0 x) 1 -1)
  312.             (+ (mref-16-u x 6)
  313.                (%ash (+ (mref-16-u x 4)
  314.                         (%ash (fx+ (mref-16-u x 2)
  315.                                    (fixnum-ashl (fx+ (fixnum-bit-field a 0 4) 16)
  316.                                                 16))
  317.                               16))
  318.                      16))
  319.             (fx- (fixnum-bit-field a 4 11) (fx+ 1024 51)))))
  320.  
  321. (define (integer-encode-float sign m e)
  322.   (let ((float (make-flonum)))
  323.     (receive (sign mantissa exponent)
  324.              (normalize-float-parts sign
  325.                                     m
  326.                                     e
  327.                                     %%apollo-d-ieee-size 
  328.                                     %%apollo-d-ieee-excess 
  329.                                     t)
  330.       (set (mref-16-u float 0) (fx+ (fixnum-ashl sign 15)
  331.                                     (fx+ (fixnum-ashl exponent 4)
  332.                                          (bignum-bit-field mantissa 48 4))))
  333.       (set (mref-16-u float 2) (bignum-bit-field mantissa 32 16)) 
  334.       (set (mref-16-u float 4) (bignum-bit-field mantissa 16 16)) 
  335.       (set (mref-16-u float 6) (bignum-bit-field mantissa 0  16)) 
  336.       float)))
  337.  
  338.  
  339.